#|_____________________________________________________________
 |  FUNCTREG.LSP
 |
 |  Parameter estimates and their stdvs now show at
 |       least two significant digits
 |
 |  Copyright (c) 2001 by Forrest W. Young
 |_____________________________________________________________
 |#



;from function.lsp
(defmeth regression-model-proto :display 
           (&optional (w nil) (estimates t) (fit t) (test t))
"Message args: &optional (w nil) (estimates t) (fit t) (test t)
Prints to window W (listener when W nil) the least squares regression summary, including ESTIMATES FIT and TEST, when each is T. Variables not used in the fit are marked as aliased. Modified by Forrest Young from Luke Tierney's original version to include t-ratios, p-values and effect sizes."
  (let* ((coefs (coerce (send self :coef-estimates) 'list))
         (se-s (send self :coef-standard-errors))
         (t-ratio nil)
         (p-value nil)
         (x (send self :x))
         (df (send self :df))
         (totaldf (- (send self :num-cases) 1))
         (modeldf (- (length (send self :coef-estimates)) 1))
         (errordf (- totaldf modeldf))
         (totalss (send self :total-sum-of-squares))
         (errorss (send self :sum-of-squares))
         (modelss (- totalss errorss))
         (r-squared (send self :r-squared))
         (adj-r-squared (+ 1 (* (- r-squared 1) 
                                (/ (- (send self :num-cases) 1) df))))
         (p-names (send self :predictor-names)) (name)
         (max-name-l (+ 3 (max (mapcar #'length p-names))))
         (padding (apply #'strcat (repeat "." max-name-l)))
         )
    (when estimates
          (if (send self :weights) 
              (display-string 
               (format nil "~2%PARAMETER ESTIMATES (WEIGHTED LEAST SQUARES):") w)
              (display-string 
               (format nil "~2%PARAMETER ESTIMATES (LEAST SQUARES)") w))
          (display-string (format nil " WITH TWO-TAILED T-TESTS.") w)
          (display-string (format nil "~%~a   Estimate  Std. Error    t-Ratio  P-Value~%"
                                  (select (strcat "Term" padding) (iseq max-name-l))) w)
          (when (send self :intercept)
                (setf t-ratio (/ (car coefs) (car se-s)))
                (setf p-value (* 2 (- 1 (t-cdf (abs t-ratio) df))))
                (if (< p-value .0001) 
                    (setf p-value "<.0001")
                    (setf p-value (fuzz p-value 4)))
                (display-string 
                    (format nil "~a ~10a  ~10a ~10a   ~6f~%"
                            (select (strcat "Constant" padding) (iseq max-name-l))
                            (v-format (car coefs)) 
                            (v-format (car se-s)) 
                            (v-format t-ratio)
                            p-value) w)
                (setf coefs (cdr coefs))
                (setf se-s (cdr se-s)))
          (dotimes (i (array-dimension x 1)) 
                   (cond 
                     ((member i (send self :basis))
                      (setf name (select p-names i))
                      (setf name (select (strcat name padding) (iseq max-name-l)))
                      (setf t-ratio (/ (car coefs) (car se-s)))
                      (setf p-value (* 2 (- 1 (t-cdf (abs t-ratio) df))))
                      (if (< p-value .0001) 
                          (setf p-value "<.0001")
                          (setf p-value (fuzz p-value 4)))
                      (display-string (format nil "~a ~10a  ~10a ~10a   ~6f~%"
                                              name 
                                              (v-format (car coefs)) 
                                              (v-format (car se-s) )
                                              (v-format t-ratio    ) 
                                              p-value) 
                                      w)
                      (setf coefs (cdr coefs) se-s (cdr se-s)))
                     (t (display-string (format nil "~a    aliased~%" name) w))))
          (display-string (format nil "~%") w)
          )
    (when fit
          (display-string 
           (format nil "~%SUMMARY OF FIT:~%") w)
          (display-string 
           (format nil "R Squared (Total Effect Strength): ~4,2f~%" r-squared) w)
          (display-string 
           (format nil "Adjusted R Squared:              ~6,2f~%" adj-r-squared) w)
          (display-string 
           (format nil "Sigma hat (RMS error):           ~6,2f~%" (send self :sigma-hat)) w)
          (display-string 
           (format nil "Number of cases:                 ~6d~%" (send self :num-cases)) w)
          
          (if (/= (send self :num-cases) (send self :num-included))
              (display-string 
               (format nil "Number of cases used:            ~6d~%" 
                       (send self :num-included)) w))
          (display-string 
           (format nil "Degrees of freedom:              ~6d~2%" df) w)
          )

    (when test
          (display-string (format nil "~%ANALYSIS OF VARIANCE: MODEL TEST                               Signficance  Strength") w)
          (display-string (format nil "~%Source             Sum-of-Squares   df   Mean-Square   F-Ratio   P-Value    R-Square~%") w)
          (send self :anova-table-line w "Model" modelss modeldf errorss errordf totalss)
          (send self :anova-table-line w "Error" errorss errordf)
          (send self :anova-table-line w "Total" totalss totaldf)
          (display-string (format nil "~%") w))))
  
;new - put in function.lsp
(defun exponent (value)
  (let* ((str (reverse (format nil "~20,10e" (abs value))))
         (negexp (position #\- str :test #'equal))
         (posexp (position #\+ str :test #'equal))
         (exp (if negexp negexp posexp)))
    (number-from-string (reverse (select str (iseq (1+ exp)))))))


(defun v-format (value)
  (let* ((exp (exponent value)))
    (cond
      ((> exp +7) (format nil "~10,5g" value))
      ((> exp -1) (format nil "~10,2f" value))
      ((= exp -1) (format nil "~10,2f" value))
      ((= exp -2) (format nil "~10,3f" value))
      ((= exp -3) (format nil "~10,4f" value))
      ((= exp -4) (format nil "~10,5f" value))
      ((= exp -5) (format nil "~10,6f" value))
      ((= exp -6) (format nil "~10,7f" value))
      ((= exp -7) (format nil "~10,8f" value))
      (t (format nil "~10,3g" value)))))


(defmeth regression-model-proto :anova-table-line 
  (w source modelss &optional modeldf errorss errordf totalss interpret)
    (let* ((modelms nil)
           (pstring nil)
           (f nil)
           (p nil)
         (eta -1))
      (unless interpret
              (display-string (format nil "~22a ~10a " source  (v-format modelss)) w)
              (when (not (equal source "Unique"))
                    (display-string (format nil "~4d" modeldf) w)))
      (when (not (or (equal source "Total") (equal source "Unique"))) 
            (setf modelms (/ modelss modeldf))
            (unless interpret
                    (display-string (format nil "    ~10a" (v-format modelms)) w)))
      (when errorss 
            (setf f (/ modelms (/ errorss errordf)))
            (setf p (fuzz (- 1 (f-cdf f modeldf errordf)) 5))
            (setf f (fuzz f 5))
            (if totalss (setf eta (/ modelss totalss)))
            (if (< p .0001) (setf pstring "<.0001")
                (setf pstring (format nil "~6,4f" p)))
            (unless interpret
                    (display-string (format nil "~10a    ~6a ~9,3f"
                                            (v-format f) pstring eta) w)))
      (unless interpret (display-string (format nil "~%") w))
      (list f pstring eta)))